home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue71 / Clinic / LogOffSurvivorU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-05-08  |  1.9 KB  |  72 lines
  1. unit LogOffSurvivorU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ListBox1: TListBox;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.   public
  15.     function ApplicationHook(var Message: TMessage): Boolean;
  16.   end;
  17.  
  18. var
  19.   Form1: TForm1;
  20.  
  21. implementation
  22.  
  23. {$R *.DFM}
  24.  
  25. procedure RegisterMe(Register: Boolean);
  26. type
  27.   TRegisterServiceProcess = function(dwProcessId, dwType: DWord): LongBool; stdcall;
  28. const
  29.   RegisterServiceProcess: TRegisterServiceProcess = nil;
  30.   RSP_SIMPLE_SERVICE = 1;
  31.   RSP_UNREGISTER_SERVICE = 0;
  32.   Types: array[Boolean] of DWord = (RSP_UNREGISTER_SERVICE, RSP_SIMPLE_SERVICE);
  33. begin
  34.   if not Assigned(@RegisterServiceProcess) then
  35.     RegisterServiceProcess := GetProcAddress(
  36.       GetModuleHandle('Kernel32.dll'), 'RegisterServiceProcess');
  37.   if Assigned(@RegisterServiceProcess) then
  38.     Win32Check(RegisterServiceProcess(0, Types[Register]))
  39. //  API won't be found on Windows NT/2000, but that's okay
  40. //  else
  41. //    raise EWin32Error.Create('RegisterServiceProcess API not located');
  42. //    raise EWin32Error.Create('RegisterServiceProcess API not located');
  43. end;
  44.  
  45. function TForm1.ApplicationHook(var Message: TMessage): Boolean;
  46. begin
  47.   Result := False;
  48.   //If this is a user logoff...
  49.   if (Message.Msg = WM_ENDSESSION) and
  50.      (TWMEndSession(Message).Unused = LParam(ENDSESSION_LOGOFF)) then
  51.   begin
  52.     //...Stop this message being processed by the
  53.     //Application object, which would shut the application
  54.     Result := True;
  55.     Message.Result := 0;
  56.   end
  57. end;
  58.  
  59. procedure TForm1.FormCreate(Sender: TObject);
  60. begin
  61.   RegisterMe(True);
  62.   Application.HookMainWindow(ApplicationHook)
  63. end;
  64.  
  65. procedure TForm1.FormDestroy(Sender: TObject);
  66. begin
  67.   Application.UnhookMainWindow(ApplicationHook);
  68.   RegisterMe(False)
  69. end;
  70.  
  71. end.
  72.